perm filename PX[NEW,LCS] blob sn#150846 filedate 1975-03-17 generic text, type T, neo UTF8
00100		TITLE SLOOP
00200		ENTRY RNOTE,DRWNT,RDRAW,SLOOP
00300		EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF
00400		DEFINE FIXX(N)
00500	<	JUMPGE	N,.+5
00600		MOVNS	N
00700		FIX 	N,233000    
00800		MOVNS	N
00900		CAIA
01000		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01100	
01200		RB←15↔RX←14↔RA←13↔R←12↔KK←11↔L←10↔RW←7↔RZ←6
01300	SLOOP:	0
01400		MOVE	RB,.COMM.+=18	;RB=RX/71.
01500		FDVR	RB,[=71.0]
01600		SETZ	KK	;DO 81 K=0,71
01700	SLR81:	MOVE	RA,KK
01800		TLC	RA,232000
01900		FADR	RA,RA
02000		FMPR	RA,RB
02100		FADR	RA,.COMM.+4	;81	SLURX(K+1)=RB*(K)+R3
02200		MOVEI	1,SLR
02300		ADDI	1,(KK)
02400		MOVEM	RA,(1)
02500		CAIGE	KK,=71
02600		AOJA	KK,SLR81
02700		MOVE	RA,.COMM.+=8	;RA=R7*RST7
02800		FMPR	RA,.COMM.+=17
02900		MOVE	1,.COMM.+=10	;41	IF(R9.EQ.0)R9=RZZ
03000		JUMPN	1,SLR41
03100		MOVE	1,[=2.8]
03200		MOVEM	1,.COMM.+=10
03300	SLR41:	MOVE	R,.COMM.+2	;R=R+RA    CENTR IS R
03400		FADR	R,RA
03500		SETZ	L		;L=0
03600		MOVE	KK,[=36.0]	;DO 40 K=36,1,-1
03700	SLR40:	AOJ	L		;L=L+1
03800		MOVE	2,KK		;RW=R-RA*(K/36.)**R9
03900		MOVNS	RA
04000		FDVR	2,[=36.0]
04100		MOVE	3,.COMM.+=10
04200		PUSHJ	17,EXP3.2	; I HOPE!
04300		FMPR	2,RA
04400		MOVE	RW,RA
04500		FADR	RW,R
04600		MOVEI	1,INP	;	SLURY(L)=RW
04700		ADDI	1,(L)
04800		MOVEM	RW,(1)
04900		MOVE	2,[=73]	;40	SLURY(73-L)=RW
05000		SUBI	2,(L)
05100		MOVEI	1,INP
05200		ADDI	1,(2)
05300		MOVEM	RW,(1)
05400		FSBR	KK,[=1.0]
05500		JUMPG	KK,SLR40
05600		MOVE	L,[=72]		;L=72
05700	
05800		MOVE	2,.COMM.+=20	;89	IF(RTILT.EQ.0)GO TO 87
05900		JUMPE	2,SLR87		;RETURNS
06000		JSA	16,ATAN2	;RW=ATAN2(RTILT,RXX)
06100		JUMP	.COMM.+=20
06200		JUMP	.COMM.+=19
06300		MOVE	RW,0
06400		JSA	16,SIN		;RA=SIN(RW)
06500		JUMP	RW		; ????
06600		MOVE	RA,0
06700		JSA	16,COS		;RB=COS(RW)
06800		JUMP	RW
06900		MOVE	RB,0
07000		MOVE	RZ,SLR		;RZ=SLURX(1)
07100		MOVE	RW,INP+1		;RW=SLURY(1)
07200		MOVEI	KK,SLR		;DO 83 K=1,L
07300		MOVEI	4,(L)
07400		ADD	4,KK		;ADR. OF SLURX(L+1)
07500		MOVEI	SY,INP
07600	SLR83:	MOVE	R,-1(KK)	;R=SLURX(K)-RZ
07700		FSBR	R,RZ
07800		MOVE	RX,(SY)		;RXX=SLURY(K)-RW
07900		FSBR	RX,RW
08000		MOVN	2,RA	;SLURX(K)=RB*R-RA*RXX+RZ
08100		FMPR	2,RX
08200		FADR	2,RZ
08300		MOVE	3,R
08400		FMPR	3,RB
08500		FADR 	3,2
08600		MOVEM	3,-1(KK)
08700		MOVE	2,RA		;83	SLURY(K)=RB*RXX+RA*R+RW
08800		FMPR	2,R
08900		FADR	2,RW
09000		MOVE	3,RX
09100		FMPR	3,RB
09200		FADR	3,2
09300		MOVEM	3,(SY)
09400		AOJ	SY
09500		CAIGE	KK,(4)
09600		AOJA	KK,SLR83
09700		JRA	16,(16)
09800	A:	0
09900	B:	0
10000	L:	0
10100	
10200	RNOTE:	0	;	SUBROUTINE RNOTE(X)
10300		MOVE	2,@(16)	;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
10400		JSA	16,AMOD	;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
10500		JUMP	2
10600		JUMP	[=1000.0]
10700		MOVE	2,0
10800		FIXX(2)
10900		MOVEI	3,PTR
11000		ADDI	3,(2)		;END
11100		MOVE	3,-1(3)
11200		FIXX(3)
11300		MOVEI	2,XRN
11400		ADDI	2,(3)
11500		MOVE	3,-1(2)
11600		MOVEM	3,@(16)
11700		JSA	16,1(16)
11800	
11900	DRWNT:	0   	;	SUBROUTINE DRWNT(RMINI)
12000		MOVE	5,.COMM.+2	;COMMON /STF/RSTFAC(-3/4),RSTJ2
12100		SETOM	.COMM.+=29	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)	
12200		MOVE	7,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
12300		MOVE	6,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
12400		MOVE	10,.COMM.+=8 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
12500		MOVE	2,@(16)		;RJX=CENTR
12600		FMPR	2,[=0.5]	;JH=0
12700	;  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
12800		FDVR	2,STF+=8	;RA=R6
12900		MOVEM	2,.COMM.+7		;R6=.5*RMINI/RSTJ2
13000		MOVEM	2,.COMM.+=8		;R7=R6
13100		MOVE	2,.COMM.+=22	;RJD=RJZ-3
13200		FSBR	2,[=3.0]
13300		MOVEM	2,.COMM.+5
13400	;  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
13500		MOVE	11,.COMM.+=30
13600		SETZM	.COMM.+=30		;JI=0
13700		JSA	16,CLEFS	;CALL CLEFS
13800		MOVEM	11,.COMM.+=30	;JI=R9  (I SAVED JI IN 11)
13900	;  ↑↑↑↑↑↑ NEEDED??
14000	;  FOR WHITE NOTES AND ACCIS ON PLOTTER.
14100		MOVEM	5,.COMM.+2		;CENTR=RJX
14200		MOVEM	6,.COMM.+7		;R6=RA
14300		MOVEM	7,.COMM.+=26	;R7=JG
14400		MOVEM	10,.COMM.+=8	;JE=RJE	
14500		JRA	16,1(16)	;END	(ALIGNMENT ABOVE IS OFF!)
14600	
14700	RDRAW:	0  ;	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
14800		MOVEI	2,@2(16) ;C   TO X,Y INTO ONE WORD
14900		ADD	2,@(16)		;DIMENSION XY(1)
15000		MOVE	3,@1(16)	;DO 2 K=I,IFIX(S)
15100		FIXX(3)
15200		MOVEI	10,@2(16)
15300		ADDI	10,(3)
15400		MOVEM	10,DRWNT	;SAVE IT FOR NOW
15500	RD2:	MOVEI	4,2		; L=2
15600		MOVE	5,-1(2)		; Y=XY(K)
15700		CAMGE	5,[=1000.0]	;IF(Y.LT.1000.)GO TO 3
15800		JRST	RD3
15900		MOVEI	4,3		;L=3
16000		FSBR	5,[=1000.0]	;Y=Y-1000.
16100	;   >1000 = INVIS. LINE
16200	RD3:	MOVE	6,5	;3	M=Y
16300		MOVEM	4,L
16400		FIXX(6)		; M
16500		MOVE	7,6	;Y=(Y-M)*1000.
16600		TLC	7,232000
16700		FADR	7,7	; FLOATS
16800		FSBR	5,7
16900		FMPR	5,[=1000.0]	; Y
17000		CAMG	5,[=100.0]	;IF(Y.GT.100.)Y=100-Y
17100		JRST 	RD4
17200		FSBR	5,[=100.0]
17300		MOVNS	5
17400	RD4:	FMPR	5,@3(16)
17500	;   Y NUMBERS .GT.100 ARE NEG.
17600		FADR	5,@5(16)	;B=Y*X+CENTR
17700		CAIG	6,=60		;IF(M.GT.60)M=100-M
17800		JRST	RD5
17900		SUBI	6,=100
18000		MOVNS	6
18100	RD5:	TLC	6,232000     ;	A=M*RMINI+R3
18200		FADR	6,6
18300		FMPR	6,@6(16)
18400		FADR	6,@4(16)
18500		MOVEM	6,A
18600		MOVEM	5,B
18700		MOVEM	2,RNOTE		;SAVE IT FOR A SECOND
18800		JSA	16,LINES	;2	CALL LINES(A,B,L)
18900		JUMP	A
19000		JUMP	B
19100		JUMP	L
19200		MOVE	2,RNOTE
19300		CAMGE	2,DRWNT
19400		AOJA	2,RD2
19500		JRA	16,7(16)
19600	
19700		END